home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0199.ZIP / FNTDEMO3.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-08  |  11KB  |  246 lines
  1.    (* ************************************************************* *)
  2.    (*                                                               *)
  3.    (*                  NewFonts.Pas  Demo3                          *)
  4.    (*                                                               *)
  5.    (*   This program uses several small files generated by the      *)
  6.    (*   IncFile option in the NewFonts utility. In each case the    *)
  7.    (*   tail of zero bytes was deleted and the array index was      *)
  8.    (*   adjusted.                                                   *)
  9.    (*   FrameFonts contains the 8 characters used to draw the red   *)
  10.    (*   screen frame. ShadowFonts,RomanFonts,FatFonts, and Small-   *)
  11.    (*   Fonts are redesigned alphabets (A..Z, uppercase only).      *)
  12.    (*   ChemFonts contains subscripts and superscripts needed for   *)
  13.    (*   chemical and mathematical expressions.                      *)
  14.    (*                                                               *)
  15.    (*   Notice that the font sets may vary in size and that it is   *)
  16.    (*   not necessary to redefine all 128 characters when using a   *)
  17.    (*   font set. These are all partial sets, however, you cannot   *)
  18.    (*   trust the undefined characters to remain unchanged. You     *)
  19.    (*   must reload the high Ascii set again if you wish to use it. *)
  20.    (*                                                               *)
  21.    (*                                  (c) Donald L. Pavia          *)
  22.    (*                                  Department of Chemistry      *)
  23.    (*      FONTDEMO3.PAS               Western Washington Univ.     *)
  24.    (*                                  Bellingham, WA   98225       *)
  25.    (*                                                               *)
  26.    (*                                        February 1986          *)
  27.    (*                                                               *)
  28.    (* ************************************************************* *)
  29.  
  30.  
  31. program FontDemo3;
  32.  
  33. {----------------------------------------------------------------------------}
  34. const FrameFonts : array[1..80] of byte =
  35.    ( 127,64,95,81,93,69,125,1,223,80,87,85,93,65,127,0,
  36.      253,5,117,85,93,65,127,0,255,1,125,69,93,81,95,64,
  37.      127,64,95,81,93,69,125,1,127,1,125,69,93,81,95,64,
  38.      127,64,95,81,93,69,125,0,127,65,93,85,87,80,223,0,
  39.      127,65,93,85,117,5,253,0,127,1,125,69,93,81,223,0 );
  40. {----------------------------------------------------------------------------}
  41. const ShadowFonts : array[1..208] of byte =
  42.    ( 254,82,82,94,82,82,243,0,254,82,82,94,82,82,254,0,
  43.      254,162,160,160,160,162,254,0,254,82,82,82,82,82,254,0,
  44.      254,82,80,92,80,82,254,0,254,82,80,92,80,80,248,0,
  45.      254,162,160,174,162,162,254,0,243,82,82,94,82,82,243,0,
  46.      124,40,40,40,40,40,124,0,127,20,20,20,20,148,252,0,
  47.      243,82,86,92,94,82,243,0,248,80,80,80,82,86,254,0,
  48.      231,166,182,190,170,162,227,0,231,162,178,186,174,166,227,0,
  49.      254,162,162,162,162,162,254,0,254,82,82,94,80,80,248,0,
  50.      254,162,162,162,162,174,254,7,254,82,82,92,82,82,243,0,
  51.      254,162,160,254,10,138,254,0,254,170,40,40,40,40,124,0,
  52.      242,82,82,82,82,82,127,0,238,164,164,164,172,120,16,0,
  53.      227,170,170,190,182,162,227,0,198,106,52,40,88,172,198,0,
  54.      206,74,74,122,10,74,126,0,254,138,20,40,80,162,254,0 );
  55. {----------------------------------------------------------------------------}
  56. const RomanFonts : array[1..208] of byte =
  57.    ( 24,60,66,66,126,66,66,0,252,66,66,124,66,66,252,0,
  58.      60,66,64,64,64,66,60,0,252,66,66,66,66,66,252,0,
  59.      254,66,64,120,64,66,254,0,254,66,64,120,64,64,224,0,
  60.      60,66,64,78,66,66,60,0,66,66,66,126,66,66,66,0,
  61.      62,8,8,8,8,8,62,0,14,4,4,4,4,68,56,0,
  62.      198,68,72,112,72,68,198,0,224,64,64,64,66,70,254,0,
  63.      99,119,93,73,65,65,65,0,195,98,114,90,78,70,194,0,
  64.      60,66,66,66,66,66,60,0,252,66,66,124,64,64,240,0,
  65.      60,66,66,66,66,74,60,2,252,66,66,124,66,66,231,0,
  66.      126,66,64,126,2,66,126,0,254,146,16,16,16,16,56,0,
  67.      66,66,66,66,66,66,60,0,66,66,66,66,66,60,24,0,
  68.      65,65,65,73,93,119,99,0,66,66,36,24,24,36,66,0,
  69.      198,68,68,56,16,16,56,0,126,66,4,8,16,34,126,0 );
  70. {----------------------------------------------------------------------------}
  71. const FatFonts : array[1..208] of byte =
  72.    ( 16,56,108,108,254,238,238,0,252,246,246,252,246,246,252,0,
  73.      62,118,246,240,246,118,62,0,252,254,246,246,246,254,252,0,
  74.      254,254,240,252,240,254,254,0,254,254,240,252,240,240,240,0,
  75.      62,126,224,238,226,126,62,0,230,230,254,254,254,230,230,0,
  76.      60,60,60,60,60,60,60,0,30,30,30,222,222,254,124,0,
  77.      230,236,248,240,248,236,230,0,240,240,240,240,240,254,254,0,
  78.      226,246,234,226,226,226,226,0,230,230,246,254,238,230,230,0,
  79.      124,246,246,246,246,246,124,0,252,254,226,254,252,240,240,0,
  80.      124,246,246,246,246,246,126,3,252,254,226,254,252,246,243,0,
  81.      126,254,240,120,30,254,252,0,255,255,60,60,60,60,60,0,
  82.      238,238,238,238,238,254,124,0,238,238,108,124,56,56,16,0,
  83.      226,226,226,226,234,246,230,0,198,238,124,56,124,238,198,0,
  84.      198,238,124,56,56,56,56,0,254,254,252,24,62,126,254,0 );
  85. {----------------------------------------------------------------------------}
  86. const SmallFonts : array[1..208] of byte =
  87.    ( 0,56,68,124,68,68,0,0,0,124,68,124,68,124,0,0,
  88.      0,124,64,64,64,124,0,0,0,120,68,68,68,120,0,0,
  89.      0,124,64,120,64,124,0,0,0,124,64,120,64,64,0,0,
  90.      0,124,64,92,68,124,0,0,0,68,68,124,68,68,0,0,
  91.      0,56,16,16,16,56,0,0,0,4,4,4,68,124,0,0,
  92.      0,68,72,112,88,68,0,0,0,64,64,64,64,124,0,0,
  93.      0,66,102,90,66,66,0,0,0,68,100,84,76,68,0,0,
  94.      0,56,68,68,68,56,0,0,0,124,68,124,64,64,0,0,
  95.      0,56,68,68,84,60,4,0,0,124,68,120,76,68,0,0,
  96.      0,124,64,124,4,124,0,0,0,124,16,16,16,16,0,0,
  97.      0,68,68,68,68,56,0,0,0,68,68,40,16,16,0,0,
  98.      0,66,66,90,102,66,0,0,0,68,40,16,40,68,0,0,
  99.      0,68,40,16,16,16,0,0,0,124,8,16,32,124,0,0 );
  100. {----------------------------------------------------------------------------}
  101. const chemfonts : array[1..288] of byte =
  102.    ( 0,0,0,0,0,0,255,255,8,4,254,0,254,64,32,0,
  103.      0,0,120,204,204,204,204,120,0,0,48,112,48,48,48,120,
  104.      0,0,120,204,24,96,192,252,0,0,120,204,24,12,204,120,
  105.      0,0,60,108,204,254,12,12,0,0,248,192,248,12,12,248,
  106.      0,0,120,128,248,204,204,120,0,0,248,24,48,48,96,96,
  107.      0,0,120,204,120,204,204,120,0,0,120,204,204,124,24,112,
  108.      96,144,144,144,96,0,0,0,32,96,32,32,32,0,0,0,
  109.      112,152,48,96,248,0,0,0,112,152,48,152,112,0,0,0,
  110.      48,80,144,248,16,0,0,0,240,128,224,16,224,0,0,0,
  111.      96,128,224,144,96,0,0,0,240,16,32,64,128,0,0,0,
  112.      96,144,96,144,96,0,0,0,96,144,112,16,96,0,0,0,
  113.      32,32,248,32,32,0,0,0,0,0,240,0,0,0,0,0,
  114.      0,0,0,60,6,62,102,59,0,0,96,32,60,38,38,92,
  115.      0,118,220,0,118,220,0,0,16,16,16,16,16,16,16,0,
  116.      72,72,72,72,72,72,72,0,252,0,0,252,0,0,252,0,
  117.      128,64,32,16,8,4,2,1,1,2,4,8,16,32,64,128,
  118.      0,0,0,204,204,0,0,0,255,255,0,0,0,0,0,0,
  119.      32,112,248,248,0,0,0,0,0,255,255,255,255,255,255,0 );
  120. {----------------------------------------------------------------------------}
  121. procedure UseFrameFonts;
  122.  
  123. begin
  124.  memw[$0000:$007E] := seg(FrameFonts); memw[$0000:$007C] := ofs(FrameFonts);
  125.  
  126. end; { procedure UseFrameFonts }
  127. {----------------------------------------------------------------------------}
  128. procedure UseShadowFonts;
  129.  
  130. begin
  131.  memw[$0000:$007E] := seg(ShadowFonts); memw[$0000:$007C] := ofs(ShadowFonts);
  132.  
  133. end; { procedure UseShadowFonts }
  134. {----------------------------------------------------------------------------}
  135. procedure UseRomanFonts;
  136.  
  137. begin
  138.  memw[$0000:$007E] := seg(RomanFonts); memw[$0000:$007C] := ofs(RomanFonts);
  139.  
  140. end; { procedure UseRomanFonts }
  141. {----------------------------------------------------------------------------}
  142. procedure UseFatFonts;
  143.  
  144. begin
  145.  memw[$0000:$007E] := seg(FatFonts); memw[$0000:$007C] := ofs(FatFonts);
  146.  
  147. end; { procedure UseFatFonts }
  148. {----------------------------------------------------------------------------}
  149. procedure UseSmallFonts;
  150.  
  151. begin
  152.  memw[$0000:$007E] := seg(SmallFonts); memw[$0000:$007C] := ofs(SmallFonts);
  153.  
  154. end; { procedure UseSmallFonts }
  155. {----------------------------------------------------------------------------}
  156. procedure UseChemFonts;
  157.  
  158. begin
  159.  memw[$0000:$007E] := seg(ChemFonts); memw[$0000:$007C] := ofs(ChemFonts);
  160.  
  161. end; { procedure UseChemFonts }
  162. {----------------------------------------------------------------------------}
  163.  
  164. var   q : integer; Wait : char;
  165.  
  166. BEGIN
  167.       clrscr; GraphColorMode; GraphBackGround (1); Palette (2);
  168.  
  169.       Draw (0,0,319,0,1);     Draw (319,0,319,199,1);
  170.       Draw (319,199,0,199,1); Draw (0,199,0,0,1);
  171.  
  172.       {----------- FRAME BORDER ----------------------------------}
  173.  
  174.       UseFrameFonts;
  175.  
  176.       TextColor (2);
  177.       gotoxy (2,2); write (#128);
  178.       for q := 3  to 19 do begin gotoxy (q,2); write (#129); end;
  179.       for q := 20 to 38 do begin gotoxy (q,2); write (#130); end;
  180.       gotoxy (39,2); write (#131);
  181.       for q := 3 to 23 do begin
  182.            gotoxy (2,q);  write (#132);
  183.            gotoxy (39,q); write (#133);
  184.       end;
  185.       gotoxy (2,24); write (#134);
  186.       for q := 3  to 19 do begin gotoxy (q,24); write (#135); end;
  187.       for q := 20 to 38 do begin gotoxy (q,24); write (#136); end;
  188.       gotoxy (39,24); write (#137);
  189.  
  190.       {------- TURBO PASCAL --------------------------------------}
  191.  
  192.       UseShadowFonts;
  193.  
  194.       TextColor (3);
  195.       gotoxy (15,6);  write (#147,#148,#145,#129,#142,' ');
  196.                       write (#143,#128,#146,#130,#128,#139);
  197.  
  198.       {--------GRAPHICS -- FONT -- DESIGNER-----------------------}
  199.  
  200.       UseRomanFonts;
  201.  
  202.       TextColor (1);
  203.       gotoxy (10,9);   write (#134,#145,#128,#143,#135,#136,#130,#146,' ');
  204.                        write (#133,#142,#141,#147,' ');
  205.                        write (#131,#132,#146,#136,#134,#141,#132,#145);
  206.  
  207.       {-------- PROGRAMMER'S - UTILITY ---------------------------}
  208.  
  209.       UseFatFonts;
  210.  
  211.       TextColor (3);
  212.       gotoxy (11,12);  write (#143,#145,#142,#134,#145,#128,#140,#140,#132);
  213.                        write (#145,'''',#146);
  214.                        write (' ',#148,#147,#136,#139,#136,#147,#152);
  215.  
  216.       {------------------------------------------------------------}
  217.  
  218.       { regular lo-ascii fonts }
  219.  
  220.       TextColor (1);
  221.       gotoxy (13,16);  write ('Donald L. Pavia');
  222.  
  223.       {-------- DEPARTMENT OF CHEMISTRY ---------------------------}
  224.  
  225.       UseSmallFonts;
  226.  
  227.       TextColor (3); gotoxy (10,19);
  228.       write (#131,#132,#143,#128,#145,#147,#140,#132,#141,#147);
  229.       write (' ',#142,#133,' ');
  230.       write (#130,#135,#132,#140,#136,#146,#147,#145,#152);
  231.  
  232.       {-------- WESTERN WASHINGTON UNIVERSITY ---------------------}
  233.  
  234.       gotoxy (7,20);   write (#150,#132,#146,#147,#132,#145,#141,' ');
  235.             write (#150,#128,#146,#135,#136,#141,#134,#147,#142,#141);
  236.             write (' ',#148,#141,#136,#149,#132,#145,#146,#136,#147,#152);
  237.  
  238.       {-------- BELLINGHAM  WASHINGTON -----------------------------}
  239.  
  240.       gotoxy(10,21); write (#129,#132,#139,#139,#136,#141,#134,#135,#128,#140);
  241.                write ('   ',#150,#128,#146,#135,#136,#141,#134,#147,#142,#141);
  242.  
  243.       read (Kbd,Wait); TextMode (c80);
  244.  
  245. END.
  246.